perm filename INSANE.LAP[206,JMC] blob sn#070511 filedate 1973-11-02 generic text, type T, neo UTF8
(LAP CYCLES SUBR) 
       (PUSH P 1) 
       (PUSH P 1) 
       (PUSH P (C 0 0 (QUOTE NIL) 0)) 
       (PUSH P (C 0 0 (QUOTE NIL) 0)) 
       (PUSH P (C 0 0 (QUOTE NIL) 0)) 
 TAG1  (MOVE 1 -4 P) 
       (JUMPE 1 TAG6) 
       (PUSH P -4 P) 
       (MOVE 2 0 P) 
       (MOVE 1 -4 P) 
       (CALL 2 (E UPTO) S) 
       (MOVE 2 1) 
       (POP P 1) 
       (CALL 2 (E *APPEND) S) 
       (CALL 1 (E NCONS) S) 
       (MOVEM 1 -2 P) 
       (MOVE 1 -1 P) 
       (JUMPE 1 TAG12) 
       (MOVE 1 -2 P) 
       (HRRM@ 1 -1 P) 
       (HRRZ@ 2 -1 P) 
       (JRST 0 TAG11) 
 TAG12 (MOVE 2 -2 P) 
       (MOVEM 2 0 P) 
 TAG11 (HRRZ@ 1 -4 P) 
       (MOVEM 1 -4 P) 
       (MOVEM 2 -1 P) 
       (JRST 0 TAG1) 
 TAG6  (MOVE 1 0 P) 
       (SUB P (C 5 0 5 0)) 
       (POPJ P) 
       NIL 

(LAP UPTO SUBR) 
       (PUSH P 1) 
       (PUSH P 2) 
       (CAME 2 1) 
       (JRST 0 TAG2) 
       (MOVEI 1 (QUOTE NIL)) 
       (JRST 0 TAG1) 
 TAG2  (HLRZ@ 1 -1 P) 
       (MOVE 2 0 P) 
       (PUSH P 1) 
       (HRRZ@ 1 -2 P) 
       (CALL 2 (E UPTO) S) 
       (POP P 2) 
       (CALL 2 (E XCONS) S) 
 TAG1  (SUB P (C 2 0 2 0)) 
       (POPJ P) 
       NIL 

(LAP PRUP SUBR) 
       (PUSH P 1) 
       (PUSH P 2) 
       (JUMPE 1 TAG1) 
       (HLRZ@ 2 0 P) 
       (HLRZ@ 1 -1 P) 
       (CALL 2 (E CONS) S) 
       (HRRZ@ 2 0 P) 
       (PUSH P 1) 
       (HRRZ@ 1 -2 P) 
       (CALL 2 (E PRUP) S) 
       (POP P 2) 
       (CALL 2 (E XCONS) S) 
 TAG1  (SUB P (C 2 0 2 0)) 
       (POPJ P) 
       NIL 

(LAP SUBFUN1LOSE SUBR) 
       (HRRZ@ 2 1) 
       (HLRZ@ 1 1) 
       (JCALL 2 (E MEMBER) S) 
       NIL 

(LAP LOSE SUBR) 
       (MOVE 2 1) 
       (MOVEI 1 (QUOTE SUBFUN1LOSE) S) 
       (JCALL 2 (E ORLIS) S) 
       NIL 

(LAP TER SUBR) 
       (HLRZ@ 1 1) 
       (CALL 1 (E LENGTH) S) 
       (MOVEI 2 (QUOTE 4)) 
       (JCALL 2 (E EQUAL) S) 
       NIL 

(LAP SUBFUN1SUCCESSORS SUBR) 
       (JCALL 2 (E XCONS) S) 
       NIL 

(LAP SUCCESSORS SUBR) 
       (PUSH P 1) 
       (HLRZ@ 1 1) 
       (CALL 1 (E LENGTH) S) 
       (PUSH P (SPECIAL PUZZ) S) 
       (CALL 1 (E ADD1) S) 
       (MOVE 2 1) 
       (POP P 1) 
       (CALL 2 (E NTH) S) 
       (HLRZ@ 2 1) 
       (PUSH P 2) 
       (PUSH P (C 0 0 (QUOTE NIL) 0)) 
       (PUSH P (C 0 0 (QUOTE NIL) 0)) 
       (PUSH P (C 0 0 (QUOTE NIL) 0)) 
 TAG1  (MOVE 1 -3 P) 
       (JUMPE 1 TAG6) 
       (HLRZ@ 1 -3 P) 
       (MOVE 3 1) 
       (MOVE 2 -4 P) 
       (MOVEI 1 (QUOTE SUBFUN1SUCCESSORS) S) 
       (CALL 3 (E MAPCAR2) S) 
       (CALL 1 (E NCONS) S) 
       (MOVEM 1 -2 P) 
       (MOVE 1 -1 P) 
       (JUMPE 1 TAG12) 
       (MOVE 1 -2 P) 
       (HRRM@ 1 -1 P) 
       (HRRZ@ 2 -1 P) 
       (JRST 0 TAG11) 
 TAG12 (MOVE 2 -2 P) 
       (MOVEM 2 0 P) 
 TAG11 (HRRZ@ 1 -3 P) 
       (MOVEM 1 -3 P) 
       (MOVEM 2 -1 P) 
       (JRST 0 TAG1) 
 TAG6  (MOVE 1 0 P) 
       (SUB P (C 5 0 5 0)) 
       (POPJ P) 
       NIL 

(SETQ PUZZ3 (APPEND (CYCLES (QUOTE (2 3 4 5))) (CYCLES (QUOTE (2 5 4 3))) (CYCLES (QUOTE (1 2 6 4))) (CYCLES (QU→
OTE (1 4 6 2))) (CYCLES (QUOTE (1 3 6 5))) (CYCLES (QUOTE (1 5 6 3))))) 

(SETQ PUZZ1 (QUOTE ((G B B W R G) (G G B G W R) (G W W R B R) (G G R B W W)))) 

(SETQ PUZZ2 (MAPCAR (FUNCTION (LAMBDA (X) (PRUP (QUOTE (1 2 3 4 5 6)) X))) PUZZ1)) 

(SETQ PUZZ4 (MAPCAR (FUNCTION (LAMBDA (S) (SUBLIS S PUZZ3))) PUZZ2)) 

(SETQ PUZZ (CONS (LIST (CAR (NTH (CAR PUZZ4) 1)) (CAR (NTH (CAR PUZZ4) 11)) (CAR (NTH (CAR PUZZ4) 21))) (CDR PUZ→
Z4))) 

(SETQ P0 (QUOTE (NIL NIL NIL NIL)))